home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / tcl / tclx7_31.z / tclx7_31 / tcldev / tclX7.3a-p1 / tests / profile.test < prev    next >
Encoding:
Text File  |  1994-01-23  |  10.5 KB  |  334 lines
  1. #
  2. # profile.test
  3. #
  4. # Tests for the profile command and profrep procedure.
  5. #---------------------------------------------------------------------------
  6. # Copyright 1992-1993 Karl Lehenbauer and Mark Diekhans.
  7. #
  8. # Permission to use, copy, modify, and distribute this software and its
  9. # documentation for any purpose and without fee is hereby granted, provided
  10. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11. # Mark Diekhans make no representations about the suitability of this
  12. # software for any purpose.  It is provided "as is" without express or
  13. # implied warranty.
  14. #------------------------------------------------------------------------------
  15. # $Id: profile.test,v 3.0 1993/11/19 06:57:59 markd Rel $
  16. #------------------------------------------------------------------------------
  17. #
  18.  
  19. if {[info procs test] != "test"} then {source testlib.tcl}
  20.  
  21. # Make sure we that real time is not zero.  If so, suggest compiling with a
  22. # different parameter.
  23.  
  24. proc ProcA1 {} {sleep 1}
  25. profile on
  26. ProcA1
  27. profile off profData
  28. foreach idx [array names profData] {
  29.    if [string match "ProcA1 *" $idx] break
  30. }
  31.  
  32. if {[lindex $profData($idx) 1] == 0} {
  33.     puts stderr "*** The profile command is returning real time values of"
  34.     puts stderr "*** zero.  This suggests that your `times' system call does"
  35.     puts stderr "*** not return elapsed real time.  The configure script"
  36.     puts stderr "*** did not properly detect this.  Try defining the flag"
  37.     puts stderr "*** TIMES_RETS_REAL_TIME in src/tclXconfig.h and reporting"
  38.     puts stderr "*** this to the maintainers"
  39. }
  40.  
  41. #
  42. # Function to build a list from the profile output data with each entry
  43. # contain the call stack and call count.  The list is returned sorted by
  44. # call stack.
  45. #
  46.  
  47. proc SumCntData {profDataVar} {
  48.     upvar $profDataVar profData
  49.     set sumData {}
  50.     foreach stack [array names profData] {
  51.         lappend sumData [list $stack [lindex $profData($stack) 0]]
  52.     }
  53.     return [lsort $sumData]
  54. }
  55.  
  56. proc ProcA1 {} {ProcB1}
  57. proc ProcB1 {} {ProcC1;ProcC1}
  58. proc ProcC1 {} {}
  59.  
  60. Test profile-1.1 {profile count tests} {
  61.    profile on
  62.    ProcA1
  63.    profile off profData
  64.    SumCntData profData
  65. } 0 [list {<global> 1} \
  66.           {{ProcA1 <global>} 1} \
  67.           {{ProcB1 ProcA1 <global>} 1} \
  68.           {{ProcC1 ProcB1 ProcA1 <global>} 2}]
  69.  
  70. proc ProcA2 {} {ProcB2}
  71. proc ProcB2 {} {ProcC2}
  72. proc ProcC2 {} {uplevel ProcD2; ProcD2}
  73. proc ProcD2 {} {}
  74.  
  75. Test profile-1.2 {profile count tests} {
  76.    profile on
  77.    ProcA2
  78.    profile off profData
  79.    SumCntData profData
  80. } 0 [list {<global> 1} \
  81.           {{ProcA2 <global>} 1} \
  82.           {{ProcB2 ProcA2 <global>} 1} \
  83.           {{ProcC2 ProcB2 ProcA2 <global>} 1} \
  84.           {{ProcD2 ProcB2 ProcA2 <global>} 1} \
  85.           {{ProcD2 ProcC2 ProcB2 ProcA2 <global>} 1}]
  86.  
  87. proc ProcA3 {} {ProcB3}
  88. proc ProcB3 {} {catch {ProcC3};ProcE3}
  89. proc ProcC3 {} {ProcD3}
  90. proc ProcD3 {} {error baz}
  91. proc ProcE3 {} {}
  92.  
  93. Test profile-1.3 {profile count tests} {
  94.    profile on
  95.    ProcA3
  96.    profile off profData
  97.    SumCntData profData
  98. } 0 [list {<global> 1} \
  99.           {{ProcA3 <global>} 1} \
  100.           {{ProcB3 ProcA3 <global>} 1} \
  101.           {{ProcC3 ProcB3 ProcA3 <global>} 1} \
  102.           {{ProcD3 ProcC3 ProcB3 ProcA3 <global>} 1} \
  103.           {{ProcE3 ProcB3 ProcA3 <global>} 1}]
  104.  
  105. #
  106. # Function to build a list from the profile output data with each entry
  107. # contain the call stack and call count.  The list is returned sorted by
  108. # CPU time.  CPU time is not included in the return, since it can't be
  109. # verified exactly, only approximately.
  110. #
  111.  
  112. proc SumCpuData {profDataVar} {
  113.     upvar $profDataVar profData
  114.     set sumData {}
  115.     foreach stack [array names profData] {
  116.         lappend sumData [list [format %032d [lindex $profData($stack) 2]] \
  117.                               $stack [lindex $profData($stack) 0]]
  118.     }
  119.     set retData {}
  120.     foreach entry $sumData {
  121.         lappend retData [lrange $entry 1 end]
  122.     }
  123.     return [lsort $retData]
  124. }
  125.  
  126. proc EatTime {amount} {
  127.     set end   [expr [lindex [times] 0]+$amount]
  128.     while {[lindex [times] 0] < $end} {
  129.         format %d 100  ;# kind of slow command.
  130.     }    
  131. }
  132.  
  133. proc ProcA4 {} {ProcB4;ProcC4;ProcD4}
  134. proc ProcB4 {} {EatTime 1}
  135. proc ProcC4 {} {EatTime 100}
  136. proc ProcD4 {} {EatTime 1000}
  137.  
  138. Test profile-2.1 {profile CPU time tests} {
  139.    profile on
  140.    ProcA4
  141.    profile off profData
  142.    SumCpuData profData
  143. } 0 [list {<global> 1} \
  144.           {{EatTime ProcB4 ProcA4 <global>} 1} \
  145.           {{EatTime ProcC4 ProcA4 <global>} 1} \
  146.           {{EatTime ProcD4 ProcA4 <global>} 1} \
  147.           {{ProcA4 <global>} 1} {{ProcB4 ProcA4 <global>} 1} \
  148.           {{ProcC4 ProcA4 <global>} 1} {{ProcD4 ProcA4 <global>} 1}]
  149.  
  150. proc ProcA1 {} {ProcB1;set a 1;incr a}
  151. proc ProcB1 {} {ProcC1;ProcC1}
  152. proc ProcC1 {} {set a 1;incr a}
  153.  
  154. Test profile-3.1 {profile -command tests} {
  155.    profile -commands on
  156.    ProcA1
  157.    profile off profData
  158.    SumCntData profData
  159. } 0 [list {<global> 1} \
  160.           {{ProcA1 <global>} 1} \
  161.           {{ProcB1 ProcA1 <global>} 1} \
  162.           {{ProcC1 ProcB1 ProcA1 <global>} 2} \
  163.           {{incr ProcA1 <global>} 1} \
  164.           {{incr ProcC1 ProcB1 ProcA1 <global>} 2} \
  165.           {{profile <global>} 1} {{set ProcA1 <global>} 1} \
  166.           {{set ProcC1 ProcB1 ProcA1 <global>} 2}]
  167.  
  168. Test profile-4.1 {profile error tests} {
  169.     profile off
  170. } 1 {wrong # args: profile ?-commands? on|off arrayVar}
  171.  
  172. Test profile-4.2 {profile error tests} {
  173.     profile baz
  174. } 1 {expected one of "on" or "off", got "baz"}
  175.  
  176. Test profile-4.3 {profile error tests} {
  177.     profile -comman on
  178. } 1 {expected option of "-commands", got "-comman"}
  179.  
  180. Test profile-4.4 {profile error tests} {
  181.     profile -commands off
  182. } 1 {wrong # args: profile ?-commands? on|off arrayVar}
  183.  
  184. Test profile-4.5 {profile error tests} {
  185.     profile -commands
  186. } 1 {wrong # args: profile ?-commands? on|off arrayVar}
  187.  
  188. Test profile-4.6 {profile error tests} {
  189.     profile -commands on foo
  190. } 1 {wrong # args: profile ?-commands? on|off arrayVar}
  191.  
  192. Test profile-4.7 {profile error tests} {
  193.     profile off foo
  194. } 1 {profiling is not currently enabled}
  195.  
  196. Test profile-4.8 {profile error tests} {
  197.     profile on
  198.     profile on
  199. } 1 {profiling is already enabled}
  200. profile off foo
  201.  
  202. #
  203. # Set up some dummy profile data for the report tests.  The data is not
  204. # realistic, but designed so that no two numbers that are sorted on are the
  205. # same.
  206. #
  207. catch {unset profData}
  208. set baz {EatTime ProcB4 ProcA4}
  209. set profData($baz) {4 800 10}
  210. set baz {ProcC4 ProcA4}
  211. set profData($baz) {3 1000 100}
  212. set baz {EatTime ProcC4 ProcA4}
  213. set profData($baz) {2 1000 100}
  214. set baz {ProcD4 ProcA4}
  215. set profData($baz) {1 100 1070}
  216. set baz ProcA4
  217. set profData($baz) {5 1250 1180}
  218. set baz {EatTime ProcD4 ProcA4}
  219. set profData($baz) {6 1070 1070}
  220. set baz {ProcB4 ProcA4}
  221. set profData($baz) {7 80 11}
  222.  
  223. #
  224. # Read the profile report into memory and purge the file
  225. #
  226. proc GetProfRep {fileName} {
  227.     set fh [open $fileName]
  228.     set data [read $fh]
  229.     close $fh
  230.     unlink $fileName
  231.     return $data
  232. }
  233.  
  234. eval $SAVED_UNKNOWN
  235.  
  236. Test profile-5.1 {profrep tests} {
  237.     profrep profData calls 1 prof.tmp "Profile Test 5.1"
  238.     GetProfRep prof.tmp
  239. } 0 {---------------------------------------------------------
  240. Profile Test 5.1
  241. ---------------------------------------------------------
  242. Procedure Call Stack          Calls  Real Time   CPU Time
  243. ---------------------------------------------------------
  244. EatTime                          12       2870       1180
  245. ProcB4                            7         80         11
  246. ProcA4                            5       1250       1180
  247. ProcC4                            3       1000        100
  248. ProcD4                            1        100       1070
  249. }
  250.  
  251. Test profile-5.2 {profrep tests} {
  252.     profrep profData real 1 prof.tmp "Profile Test 5.2"
  253.     GetProfRep prof.tmp
  254. } 0 {---------------------------------------------------------
  255. Profile Test 5.2
  256. ---------------------------------------------------------
  257. Procedure Call Stack          Calls  Real Time   CPU Time
  258. ---------------------------------------------------------
  259. EatTime                          12       2870       1180
  260. ProcA4                            5       1250       1180
  261. ProcC4                            3       1000        100
  262. ProcD4                            1        100       1070
  263. ProcB4                            7         80         11
  264. }
  265.  
  266. Test profile-5.3 {profrep tests} {
  267.     profrep profData cpu 1 prof.tmp "Profile Test 5.3"
  268.     GetProfRep prof.tmp
  269. } 0 {---------------------------------------------------------
  270. Profile Test 5.3
  271. ---------------------------------------------------------
  272. Procedure Call Stack          Calls  Real Time   CPU Time
  273. ---------------------------------------------------------
  274. ProcA4                            5       1250       1180
  275. EatTime                          12       2870       1180
  276. ProcD4                            1        100       1070
  277. ProcC4                            3       1000        100
  278. ProcB4                            7         80         11
  279. }
  280.  
  281. Test profile-5.4 {profrep tests} {
  282.     profrep profData cpu 2 prof.tmp "Profile Test 5.4"
  283.     GetProfRep prof.tmp
  284. } 0 {---------------------------------------------------------
  285. Profile Test 5.4
  286. ---------------------------------------------------------
  287. Procedure Call Stack          Calls  Real Time   CPU Time
  288. ---------------------------------------------------------
  289. ProcA4                            5       1250       1180
  290. ProcD4                            1        100       1070
  291.     ProcA4
  292. EatTime                           6       1070       1070
  293.     ProcD4
  294. ProcC4                            3       1000        100
  295.     ProcA4
  296. EatTime                           2       1000        100
  297.     ProcC4
  298. ProcB4                            7         80         11
  299.     ProcA4
  300. EatTime                           4        800         10
  301.     ProcB4
  302. }
  303.  
  304. Test profile-5.5 {profrep tests} {
  305.     profrep profData cpu 10 prof.tmp "Profile Test 5.5"
  306.     GetProfRep prof.tmp
  307. } 0 {---------------------------------------------------------
  308. Profile Test 5.5
  309. ---------------------------------------------------------
  310. Procedure Call Stack          Calls  Real Time   CPU Time
  311. ---------------------------------------------------------
  312. ProcA4                            5       1250       1180
  313. ProcD4                            1        100       1070
  314.     ProcA4
  315. EatTime                           6       1070       1070
  316.     ProcD4
  317.     ProcA4
  318. ProcC4                            3       1000        100
  319.     ProcA4
  320. EatTime                           2       1000        100
  321.     ProcC4
  322.     ProcA4
  323. ProcB4                            7         80         11
  324.     ProcA4
  325. EatTime                           4        800         10
  326.     ProcB4
  327.     ProcA4
  328. }
  329.  
  330. unset foo
  331. rename unknown {}
  332.  
  333.  
  334.